Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d16/tprint.arc/PDEVICE.PAS

Pascal/Delphi Source File | 1991-04-10 | 8.4 KB | 287 lines

{$V-}
UNIT pDevice;
INTERFACE
USES WObjects,WinTypes,WinProcs,Strings,WinDos;
Type
  devArray = array[0..64] of Char;    {holds results of params call}
  pPrnDevice = ^tPrnDevice;
  tprnDevice = object(tObject)
    hPrintDC:  hDC;                  {print device context}
    hWindow:   hWnd;                 {parent window}
    docName:   pChar;                 {name of the document}
    device:    devArray;             {device name from windows}
    driver:    devArray;             {driver name from windows}
    dMode:     tDevMode;             {device mode record}
    noSpooler: Boolean;              {if spooler is operating}
    outPort:   devArray;             {printer port}
    okPrint:   boolean;                 {flag}

    CONSTRUCTOR Init;
    Function DeleteContext: Boolean;
    Procedure prnDeviceMode(wnd: hWnd);
    Function GetPrinterParms: Boolean;
    Function DCCreated: Boolean;
    Function beginDoc: Boolean;
    Function endDocument: Boolean;
    Function doNewFrame: Boolean; virtual;
  End;

  {-- These are types used to call the device mode dialog from a printer
      driver.  They are used in the tPrnDevice.prnDeviceMode function.
      tGetDevMode is used for drivers not written for windows 3.  The
      ExtDevMode is for windows 3 printer drivers --}

  tGetDevMode = function(hWindow: hWnd; dHan: tHandle; devName,output: pChar): Boolean;
  tGetExtDevMode = function(hWIndow: hWnd;
                            dHan: tHandle;
                            outMode: tDevMode;
                            devName: pChar;
                            outPut: pChar;
                            inMode: tDevMode;
                            profile: pChar;
                            pMode: word): Boolean;
  tMode= tDeviceMode;

  pPrinter = ^tPrinter;
  tPrinter = object(tprnDevice)
    maxX:  word;                {max width of page}
    maxY:  Word;                {max height of page}
    posX:        Word;            {current column}
    posY:         Word;            {current row}
    metrics: TTextMetric;        {text metric information}

    constructor Init;
    FUNCTION Start(dName: pChar;hw: hWnd): Boolean;
    Function CheckStart: Boolean;
    Function newAbortProc: Boolean;
    Function textLine(aStr: pChar): Boolean;
    Function Finish: Boolean;
    Function pageSize(var ps: tPoint): Boolean;
    Function height: word;
    Function endLine: Boolean;
    Function checkNewPage: Boolean;
    Function newPage: Boolean;
    Function resetPos: Boolean;
    Function doNewFrame: Boolean;virtual;
  End;

IMPLEMENTATION

CONSTRUCTOR tPrnDevice.Init;
Begin
  tObject.Init;
End;

Function tPrnDevice.deleteContext;
{-- Delete the device context for the printer --}
begin
  deleteDC(hPrintDC);
End;

Procedure tPrnDevice.prnDeviceMode;
{-- Displays the printer driver dialog box to allow the user to change
    default print parameters.  If the driver is for window 3, this call
    will only affect the current application.  Other drivers will affect
    all applications.  --}
 var
  dHandle: tHandle;     {handle of the load library for the current printer}
  drvName: pChar;       {name of the driver used to get dHandle}
  pAddr:   tFarProc;    {address of the function in the DLL we want to EXEC}


Begin
  if getPrinterParms then begin            {retrieve printer info from windows}
    drvName := driver;
    strCat(drvName,'.drv');             {make a file name out of the driver}
    dHandle := LoadLibrary(drvName);    {load the DLL for the printer}
  {-- the next instruction requests the address of a procedure called
      ExtDeviceMode from the DLL. Drivers written for windows 3 should
      contain this procedure.  if successful, that address is typecast
      to the tGetExtDevMode function type, and executed. --}

    pAddr := getProcAddress(dHandle,'ExtDeviceMode');
    if (pAddr <> nil) then begin
      tGetExtDevMode(pAddr)(wnd,dHandle,dMode,drvName,outPort,dMode,nil,dm_prompt OR dm_copy);
    end else begin
  {-- If the drivers is not written for windows 3, or there is no extDeviceMode
      procedure, the standard device mode function is called --}

      pAddr := GetProcAddress(dHandle,'DEVICEMODE');
      if (pAddr <> nil) then begin
        tGetDevMode(pAddr)(wnd,dHandle,drvName,outPort);
      End;
    End;
    FreeLibrary(dHandle);   {the library is freed when we are done with it}
  End;
end;

Function tPrnDevice.GetPrinterParms;
{-- This function retrieves the printer parameters from the WIN.INI file --}
var
  astr: array[0..255] of char;
  result: Integer;
  cPtr: pChar;
  cPos: pChar;

Begin
  result := GetProfileString('windows','device',nil,astr,sizeOF(astr));
  cPtr := aStr;
  cPos := strScan(cPtr,',');
  strLcopy(device,cPtr,(cPos - cPtr));
  cPtr := cPos + 1;
  cPos := strScan(cPtr,',');
  strLcopy(driver,cPtr,(cPos - cptr));
  cPtr := cPos + 1;
  strLcopy(outPort,cPtr,strLen(cPtr));
  result := GetProfileString('windows','spooler',nil,astr,sizeOf(aStr));
  noSpooler := (strPas(aStr) = 'no');
End;

FUNCTION tPrnDevice.DCcreated;
{-- Creates the device context for the printer --}
Begin
  hPrintDC := CreateDC(driver,device,outPort,nil);
  DCCreated := (hPrintDC > 0);
End;

Function tPrnDevice.beginDoc: Boolean;
{-- sends the startdoc escape sequence to windows --}
Begin
  beginDoc := (escape(hPrintDC,startDoc,sizeOf(docName),docName,nil) > 0);
end;

Function tPrnDevice.EndDocument: Boolean;
{-- Ends the document.  Closes the print manager, if used, and sends output
    to the printer --}
Begin
  doNewFrame;
  escape(hPrintDC,EndDoc,0,nil,nil);
End;

Function tPrnDevice.doNewFrame: Boolean;
{-- sends the newFrame escape code to windows. In the case of a printer,
    this results in a form feed --}

Begin
  doNewFrame := (escape(hPrintDC,NewFrame,0,nil,nil) > 0);
End;

(***********************************************************)
Constructor tPrinter.Init;
Begin
  tPrnDevice.Init;
End;

Function tPrinter.Start;
{-- after initialization, this method sets the printer up to print --}
var
  ap: tPoint;

Begin
  hWindow := Hw;            {save the parent window. Seemed like a good idea}
  hPrintDC := 0;            {init the device context to 0}
  GlobalCompact(0);            {compacts global memory}
{-- the next line retrieves the printer parms from WIN.INI, and creates
    the device context --}
  if (getPrinterParms and DCcreated) then begin
    docName := dName;
{-- The next few lines deal with the physical fonts.  GetTextMetrics
    retrieves the information for the printer.  Page size returns a tPoint
    record with the X and Y values for the DeviceCaps page heigth and width.
    maxX and maxY are then set at one less that these values --}

    getTextMetrics(hPrintDC,Metrics);
    pageSize(ap);
    maxX := ap.x-1;
    maxY := ap.y-1;
    start := CheckStart;
  end
  else
    start := false;
End;

Function tPrinter.CheckStart;
{-- This function will eventually set up a printer abort proc. Now, it
    only calls the beginDoc function  --}
Begin
  okPrint := true;
  newAbortProc;
  okPrint := BeginDoc;
  CheckStart := okPrint;
End;

Function tPrinter.NewAbortProc;
begin
end;

Function tPrinter.textLine(aStr: pChar): Boolean;
{-- sends a line of text to the printer, starting at the X and Y
    co-ordinates.  End line adjusts the row based on the height of
    the font from the textMetrics record  --}
Begin
  if OkPrint then begin
    if TextOut(hPrintDC,posX,posY,aStr,strLen(aStr)) then
      endLine;
  End;
end;

Function tPrinter.Finish;
{-- Ends the print job --}
Begin
  EndDocument;
  deleteContext;
End;

Function tPrinter.PageSize(var ps: tPoint): Boolean;
{-- Calls the device caps function to get the size of the page --}
Begin
  ps.X := GetDeviceCaps(hPrintDC,HorzRes);
  ps.Y := GetDeviceCaps(hPrintDC,VertRes);
end;

Function tPrinter.height: word;
{-- returns the height of the font. If your line spacing
    is to tight, you can return a different value, and
    increase it.   --}
Begin
  height := metrics.tmHeight;
End;

Function tPrinter.EndLine: Boolean;
{-- causes a 'line feed' by incrementing the row by the height of the font --}
Begin
  posX := 0;
  posY := posY + height;
  checkNewPage;
End;

Function tPrinter.CheckNewPage: Boolean;
{-- compares the row with the page height to see if a new page is required --}
Begin
  if (posY > maxY) then
    newPage;
End;

Function tPrinter.NewPage: boolean;
{-- Causes a form feed to be sent to the printer --}
Begin
  resetPos;
  doNewFrame;
End;

Function tPrinter.ResetPos: Boolean;
{-- resets the row and column to zero --}
Begin
  posX := 0;
  posY := 0;
End;

Function tPrinter.doNewFrame: Boolean;
{-- this function will do more when this unit is finished. Right now,
    it calls the ancestor new frame method to cause a line feed. --}
Begin
  if OkPrint then
    doNewFrame := tPrnDevice.doNewFrame;
End;

end.